home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1999 April / macformat-075.iso / Shareware Plus / Applications / Alpha / Tcl / Modes / bibtexMode.tcl < prev    next >
Encoding:
Text File  |  1999-02-01  |  53.3 KB  |  1,754 lines  |  [TEXT/ALFA]

  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  Vince's Additions - an extension package for Alpha
  4.  # 
  5.  #  FILE: "bibtexMode.tcl"
  6.  #                                    created: 17/8/94 {9:12:06 am} 
  7.  #                                last update: 1/2/1999 {10:38:20 pm} 
  8.  #  Updated by: Vince Darley
  9.  #  E-mail: <darley@fas.harvard.edu>
  10.  #    mail: Division of Engineering and Applied Sciences, Harvard University
  11.  #          Oxford Street, Cambridge MA 02138, USA
  12.  #     www: <http://www.fas.harvard.edu/~darley/>
  13.  #  
  14.  # Major rewrite of most of BibTeX mode.  Original by Tom Pollard.
  15.  # See the end of the BibTeX Help file for a history.
  16.  # 
  17.  # ###################################################################
  18.  ##
  19.  
  20. alpha::mode Bib 3.3.1 bibtexMenu {*.bib *.inspec *.bst *.hollis *.isi} { 
  21.     texMenu bibtexMenu electricReturn electricTab
  22. } {
  23.     addMenu bibtexMenu "•282" Bib
  24.     alpha::package require -loose AlphaTcl 7.1.8
  25. } uninstall {this-file} help {file "BibTeX Help"}
  26. # to make sure tex-mode is loaded
  27. texMenu
  28.  
  29. newPref v bibAutoIndex 1 Bib "" [list "Never make index" \
  30.   "Ask user when it is necessary" "Always remake when necessary"] index
  31.  
  32. newPref v suffixString    { \\\\} Bib
  33. newPref v prefixString {% } Bib
  34. newPref v fillColumn {65} Bib
  35. newPref f wordWrap {1} Bib
  36. newPref f autoMark {1} Bib
  37.  
  38. ###########################################################################
  39. # Search patterns for entries and cite-keys
  40. #
  41. #     set bibTopPat {^[     ]*@[a-zA-Z]+[\{\(]([-A-Za-z0-9_:/\.]+)}
  42. # match entry type
  43. set bibTopPat {^[     ]*@([a-zA-Z]+)[\{\(]}
  44. # match cite-key
  45. set bibTopPat1 {^[     ]*@[a-zA-Z]+[\{\(][     ]*([^=,     ]+)}    
  46. # match type and cite-key
  47. set bibTopPat2 {^[     ]*@([a-zA-Z]+)[\{\(][     ]*([^=,     ]+)}    
  48. # match first field (no cite-key)
  49. set bibTopPat3 {^[     ]*@([a-zA-Z]+)[\{\(]([     ]*[a-zA-Z]+[     ]*=[     ]*)}    
  50.  
  51. newPref v wordBreak {[a-zA-Z0-9]+} Bib
  52. newPref v wordBreakPreface {[^a-zA-Z0-9]} Bib
  53. newPref v funcExpr $bibTopPat Bib
  54.  
  55. newPref f overwriteBuffer {1} Bib
  56. newPref f fieldBraces {1} Bib
  57. newPref f entryBraces {1} Bib
  58. newPref f segregateStrings {1} Bib
  59. newPref f markStrings {0} Bib
  60. newPref f alignEquals {0} Bib
  61. newPref f zapEmptyFields {0} Bib
  62. newPref f descendingYears {1} Bib
  63. newPref v indentString {   } Bib
  64. newPref v stdAbbrevs {jan feb mar apr may jun jul aug sep oct nov dec} Bib
  65.  
  66. # ◊◊◊◊ Option-click title bar ◊◊◊◊ #
  67. # use TeX routines for Bib mode
  68. proc Bib::OptionTitlebar {} {TeX::OptionTitlebar}
  69. proc Bib::OptionTitlebarSelect {item} {TeX::OptionTitlebarSelect $item}
  70.  
  71. ###########################################################################
  72. # BibTeX Key Bindings.
  73. ###########################################################################
  74. # abbreviations:  <o> = option, <z> = control, <s> = shift, <c> = command
  75. #
  76. Bind 'b' <sz>    selectEntry "Bib"
  77. Bind 'n' <sz>    nextEntry "Bib"
  78. Bind 'p' <sz>    prevEntry "Bib"
  79.  
  80. Bind 'f' <sz>    searchFields "Bib"
  81. Bind 'm' <sz>    searchEntries "Bib"
  82. Bind 'l' <sz>    formatEntry "Bib"
  83.  
  84. ###########################################################################
  85. # Data Definitions
  86. ###########################################################################
  87. ###########################################################################
  88. # Define the data arrays that contain the names of the required,
  89. # optional, and preferred fields for each entry type.
  90. #
  91. # The index names of the rqdFld() array _define_ the valid entry types
  92. # recognized by the program.
  93. #
  94. set rqdFld(article) {author title journal year} 
  95. set optFld(article) {volume number pages month note}
  96. # example of how to assign your own preferences to some items
  97. #set myFld(article) {author title journal volume pages year note} 
  98.  
  99. set rqdFld(book) {author title publisher year} 
  100. set optFld(book) {editor volume number series address edition month note}
  101.  
  102. set rqdFld(booklet) {title} 
  103. set optFld(booklet) {author howpublished address month year note}
  104.  
  105. set rqdFld(conference) {author title booktitle year} 
  106. set optFld(conference) {editor volume number series pages organization publisher address month note}
  107.  
  108. set rqdFld(inBook) {author title chapter publisher year} 
  109. set optFld(inBook) {editor pages volume number series address edition month type note}
  110.  
  111. set rqdFld(inCollection) {author title booktitle publisher year} 
  112. set optFld(inCollection) {editor volume number series type chapter pages address edition month note}
  113.  
  114. set rqdFld(inProceedings) {author title booktitle year} 
  115. set optFld(inProceedings) {editor volume number series pages organization publisher address month note}
  116.  
  117. set rqdFld(manual) {title} 
  118. set optFld(manual) {author organization address edition year month note}
  119.  
  120. set rqdFld(mastersThesis) {author title school year} 
  121. set optFld(mastersThesis) {address month note type}
  122.  
  123. set rqdFld(misc) {} 
  124. set optFld(misc) {author title howpublished year month note}
  125.  
  126. set rqdFld(phdThesis) {author title school year} 
  127. set optFld(phdThesis) {address month type note}
  128.  
  129. set rqdFld(proceedings) {title year} 
  130. set optFld(proceedings) {editor volume number series publisher organization address month note}
  131.  
  132. set rqdFld(techReport) {author title institution year} 
  133. set optFld(techReport) {type number address month note}
  134.  
  135. set rqdFld(unpublished) {author title note} 
  136. set optFld(unpublished) {year month}
  137.  
  138. set entryNames [lsort [array names rqdFld]]
  139. set customEntries [lsort [array names myFld]]
  140.  
  141. ###########################################################################
  142. # Define an array of flags indicating whether the data a given field
  143. # type should be quoted.  The actual characters used to quote the field are
  144. # given by $bibOpenQuote and $bibCloseQuote, which are set by the routine
  145. # 'bibFieldDelims' according to the flag $fieldBraces.
  146. #
  147. # Note that the index names of the useBrace() array _define_ the valid 
  148. # field types recognized by the program.
  149. #
  150. array set useBrace {
  151.     address 1 annote 1 author 1 booktitle 1 chapter 0 crossref 1 edition 1 
  152.     editor 1 howpublished 1 institution 1 journal 1 key 1 language 1 month 
  153.     1 note 1 number 0 organization 1 pages 1 publisher 1 school 1 series 1 
  154.     title 1 type 1 volume 0 year 0 isbn 1 customField 1 city 1
  155. }
  156.  
  157. set fieldNames [lsort [array names useBrace]]
  158. ###########################################################################
  159. # Default values for newly created fields
  160. #
  161. set defFldVal(language) "german"
  162.  
  163. set fieldDefs [lsort [array names defFldVal]]
  164.  
  165. ###########################################################################
  166. # BibTeX-mode mode definition
  167. ###########################################################################
  168.  
  169. set bibtexKeyWords $fieldNames
  170. regModeKeywords -e {%} -m {@} -c red -k blue Bib $bibtexKeyWords
  171. unset bibtexKeyWords
  172.  
  173. ###########################################################################
  174. # BibTeX Menu Definition.
  175. ###########################################################################
  176. proc bibtexMenu {} {}
  177.  
  178. proc bibtex {} {
  179.     global bibtexSig
  180.     set name [app::launchAnyOfThese {BIBt Vbib CMTu} bibtexSig]
  181.     switchTo [file tail $name]
  182. }
  183.  
  184. menu::buildProc bibtexMenu Bib::buildBibMenu
  185.  
  186. proc Bib::buildBibMenu {} {
  187.     global bibtexMenu
  188.     return [list "build" \
  189.       [list "/-<U<Obibtex" "(-)" \
  190.       [list Menu -n Entries -p makeEntry {}] \
  191.       [list Menu -n Fields -p makeField {}] \
  192.       "(-)" \
  193.       "/B<U<BselectEntry" "/N<U<BnextEntry" "/P<U<BprevEntry" \
  194.       "/L<U<BformatEntry" "/C<U<BcopyCiteKey" \
  195.       "(-)" \
  196.       "/M<U<BsearchEntries" "/F<U<BsearchFields" \
  197.       {Menu -n sortBy... -p bibSortProc {
  198.     "citeKey"
  199.     "firstAuthor,Year"
  200.     "lastAuthor,Year"
  201.     "year,FirstAuthor"
  202.     "year,LastAuthor"}
  203.     } \
  204.       {Menu -n sortMarks... -p markSortProc {
  205.     "alphabetically"
  206.     "byPosition"}
  207.     } \
  208.       "(-)" \
  209.       "countEntries" "formatAllEntries" \
  210.       "/Q<IquickFindCitation" \
  211.       "/A<U<BaddWinToDatabase" \
  212.       "/I<U<IindexOfThisWindow" \
  213.       "(-)" \
  214.       "rebuildIndex" \
  215.       "rebuildDatabase"] \
  216.       Bib::menuProc \
  217.       [list Entries Fields] \
  218.       $bibtexMenu]
  219. }
  220.  
  221. proc Bib::menuProc {menu item} {
  222.     menu::generalProc Bib $item 0
  223. }
  224.  
  225. proc Bib::quickFindCitation {} {
  226.     Bib::GotoEntry [prompt::statusLineComplete "Citation" Bib::completionsForEntry \
  227.       -preeval {source [file join $PREFS bibIndex]} -posteval {unset bibIndex}]
  228. }
  229.  
  230. proc Bib::completionsForEntry {pref} {
  231.     Bib::_FindAllEntries $pref 0
  232. }
  233. set menu::items(Entries) [concat $entryNames "(-)" "customEntry"]
  234. set menu::proc(Entries) makeEntry
  235. set menu::items(Fields) [concat $fieldNames "(-)" "customField" "multipleFields"]
  236. set menu::proc(Fields) makeField
  237.  
  238. menu::buildSome bibtexMenu
  239.  
  240. ## 
  241.  # -------------------------------------------------------------------------
  242.  #   
  243.  # "Bib::openFile" --
  244.  #  
  245.  #  Given a filename, and the directory of the base '.aux' file, try and
  246.  #  find the file.  If we don't succeed, pass the request onto the TeX
  247.  #  code.
  248.  # -------------------------------------------------------------------------
  249.  ##
  250. proc Bib::openFile {filename {dir ""}} {
  251.     # look where base file was
  252.     if {![catch {file::openQuietly [file join ${dir} ${filename}]}]} {
  253.     return
  254.     }
  255.     # look in bibtex inputs folder
  256.     global bibtexSig
  257.     if {![catch {file::openQuietly [file join [file dirname [nameFromAppl $bibtexSig]] "BibTeX inputs" ${filename}]}]} {
  258.     return
  259.     } 
  260.     # look in all usual tex places
  261.     openTeXFile "$filename"
  262.     return
  263. }
  264.  
  265. ## 
  266.  # -------------------------------------------------------------------------
  267.  #   
  268.  # "Bib::noEntryExists" --
  269.  #  
  270.  #  No entry exists in the known .bib files.  Either add an entry, possibly
  271.  #  in a new bibliography file, or add a .bib file to those currently
  272.  #  searched.
  273.  # -------------------------------------------------------------------------
  274.  ##
  275. proc Bib::noEntryExists {item {basefile ""}} {
  276.     set basefile [Bib::getBasefile $basefile]
  277.     set choice [dialog::optionMenu \
  278.       "No entry '$item' exists.  What do you want to do?" \
  279.       [list "New entry" "New entry in new bibliography file" \
  280.       "Add .bib file to \\bibliography\{…\}" \
  281.       "Change original citation" \
  282.       "Search all bibliographies" ]]
  283.     switch -- $choice {
  284.     "New entry" {
  285.         Bib::_newEntry $item
  286.     }
  287.     "New entry in new bibliography file" {
  288.         Bib::_newEntry $item 1
  289.     }
  290.     "Add .bib file to \\bibliography\{…\}" {
  291.         Bib::insertNewBibliography $basefile    
  292.     }
  293.     "Search all bibliographies" {
  294.         alertnote "Not yet implemented"
  295.     }
  296.     "Change original citation" {
  297.         Bib::changeOriginalCitation $item $basefile
  298.     }
  299.     "Cancel" {
  300.         # nothing
  301.     }
  302.     }               
  303. }
  304.  
  305. proc Bib::_newEntry {item {new_file 0}} {
  306.     if {$new_file} {
  307.     set bibfile [putfile "Save new bibliography as…" ".bib"]
  308.     if {$bibfile == ""} {
  309.         error "No bibliography file selected."
  310.     } else {
  311.         new -n $bibfile
  312.     }        
  313.     } else {
  314.     # need to pick a .bib file
  315.     set bibfile [Bib::pickBibliography 1 \
  316.       "Select a bibliography file to which to add an entry"]
  317.     openTeXFile $bibfile
  318.     }
  319.     global entryNames
  320.     bibFormatSetup
  321.     newEntry [listpick -p "Which type of entry?" $entryNames]
  322.     insertText $item
  323.     ring::+
  324.     
  325. }
  326.  
  327. proc Bib::changeOriginalCitation {citation {basefile ""}} {
  328.     if {$basefile == ""} {set basefile [TeX_currentBaseFile]}
  329.     # find .aux and open base .tex/.ltx
  330.     if {[set proj [isWindowInFileset $basefile "tex"]] != ""} {
  331.     set files [texListFilesInFileSet $proj]
  332.     } else {
  333.     set files $basefile
  334.     }
  335.     set got "[eval grep [list $citation] $files]\r"
  336.     if {[string first "; Line " $got] == [string last "; Line " $got]} {
  337.     # just one match
  338.     if ![regexp {∞([^\r\n]*)[\r\n]} $got dmy filename] {
  339.         alertnote "I couldn't find the original.  You probably have a\
  340.           multi-part document which you haven't made into a TeX fileset.\
  341.           Unless it's a fileset, I can't find the other files."
  342.         return
  343.     }
  344.     file::openQuietly $filename
  345.     eval select [searchInFile $filename $citation 1]
  346.     message "This is the original citation.  Change it, then re-run LaTeX and BibTeX."
  347.     } else {
  348.     grepsToWindow "* List of citations *" $got
  349.     }
  350. }
  351.  
  352. proc Bib::getBasefile {{basefile ""}} {
  353.     if {$basefile == ""} {return [TeX_currentBaseFile]}
  354.     # find .aux and open base .tex/.ltx
  355.     set base [file root $basefile]
  356.     if [file exists ${base}.tex] {
  357.     return ${base}.tex
  358.     } elseif [file exists ${base}.ltx] {
  359.     return ${base}.ltx
  360.     } else {
  361.     alertnote "Base file with name '${base}.tex/ltx' not found." 
  362.     error ""
  363.     }                                   
  364. }
  365.  
  366. proc Bib::insertNewBibliography {{basefile ""} {bibfile ""}} {
  367.     set basefile [Bib::getBasefile $basefile]
  368.     file::openQuietly ${basefile}
  369.     
  370.     # find bibliography, position cursor and add
  371.     pushPosition
  372.     endOfBuffer
  373.     if {[catch {set pos [search -s -f 0 -r 0 -m 0 "\\bibliography\{" [getPos]]}]} {
  374.     # add the environment
  375.     set pos [search -s -f 0 "\\end\{document\}" [getPos]]
  376.     goto [pos::math [minPos] + [lindex $pos 0]]
  377.     set preinsert "\\bibliography\{"
  378.     set postinsert "\}\r\r"
  379.     } else {
  380.     set preinsert ""
  381.     set postinsert ","
  382.     goto [pos::math [minPos] + [lindex $pos 1]]
  383.     }
  384.     if {$bibfile == ""} {
  385.     set bibfile [Bib::pickBibliography 0 \
  386.       "Select a bibliography file to add"]
  387.     }
  388.     insertText "${preinsert}[lindex [split $bibfile "."] 0]${postinsert}"
  389.     message "press <Ctrl .> to return to original cursor position"
  390. }
  391.  
  392. # Used by Bib::pickBibliography to set a default in the listpick dialog
  393. # It's useful because you will often want to add a bunch of new items
  394. # in a row to the same bibliography.
  395. # NOTE: this is set by my code, not you.
  396. set Bib::_defaultBib ""
  397.  
  398. ## 
  399.  # -------------------------------------------------------------------------
  400.  #     
  401.  # "Bib::pickBibliography" --
  402.  #    
  403.  #    Put    up a list-dialog so    the    user can select    a bibliography file    for
  404.  #    some action    (taken by the caller).    Can    also create    a new file if
  405.  #    desired.
  406.  # -------------------------------------------------------------------------
  407.  ##
  408. proc Bib::pickBibliography {{allowNew 1} {prompt "Pick a bibliography file"}} {
  409.     set biblist [Bib::ListAllBibliographies]
  410.     if {$allowNew} {
  411.     lappend biblist {New file…}
  412.     }
  413.     global Bib::_defaultBib
  414.     set bibfile [listpick -p $prompt -L ${Bib::_defaultBib} $biblist]
  415.     if {$bibfile == ""} {
  416.     error "No bibliography file selected."
  417.     } elseif {$bibfile == "New file…" } {
  418.     set bibfile [putfile "Save new bibliography as…" ".bib"]
  419.     if {$bibfile == ""} {
  420.         error "No bibliography file selected."
  421.     } else {
  422.         set fout [open $bibfile w]
  423.         close $fout
  424.     }        
  425.     }
  426.     return [file tail [set Bib::_defaultBib $bibfile]]
  427. }
  428.  
  429. ## 
  430.  # -------------------------------------------------------------------------
  431.  #     
  432.  # "Bib::ListAllBibliographies" --
  433.  #    
  434.  #    Return all bibliographies on the search    path.  Optionally only return
  435.  #  those which are in a given .aux file.
  436.  # -------------------------------------------------------------------------
  437.  ##
  438. proc Bib::ListAllBibliographies { {auxfile ""} } {
  439.     TeXEnsureSearchPathSet
  440.     global AllTeXSearchPaths
  441.     set biblist {}
  442.     if {$auxfile == "" || [catch {set fid [open "$auxfile" r]}]} {
  443.     foreach d $AllTeXSearchPaths {
  444.         eval lappend biblist [glob -nocomplain [file join ${d} *.bib]]
  445.     }
  446.     } else {
  447.     set bibs {}
  448.     # get list of bibs from .aux file
  449.     set cid [scancontext create]
  450.     scanmatch $cid {bibdata\{([^\}]*)\}} {
  451.         eval lappend bibs [split $matchInfo(submatch0) ","]
  452.     }
  453.     scanfile $cid $fid
  454.     close $fid
  455.     scancontext delete $cid
  456.     # find the full paths
  457.     foreach b $bibs {
  458.         foreach d $AllTeXSearchPaths {
  459.         if [file exists [file join ${d} ${b}.bib]] {
  460.             lappend biblist [file join ${d} ${b}.bib]
  461.             break
  462.         }
  463.         }        
  464.     }
  465.     }
  466.     global mode
  467.     if {$mode == "TeX" || $mode == "Bib"} {
  468.     # we should add the current window's path to the search path
  469.     eval lappend biblist \
  470.       [glob -nocomplain [file join [file dirname [win::Current]] *.bib]]
  471.     }    
  472.     return $biblist
  473. }
  474.  
  475. ## 
  476.  # -------------------------------------------------------------------------
  477.  #     
  478.  # "Bib::GotoEntry" --
  479.  #    
  480.  #    Look for a bib entry in    the    given list of files, or    if that    fails or
  481.  #    isn't given, look in all available bib files on    the    search path.
  482.  # -------------------------------------------------------------------------
  483.  ##
  484. proc Bib::GotoEntry {entry {biblist {}}} {
  485.     if ![catch {Bib::gotoEntryFromIndex $entry}] {
  486.     return
  487.     }
  488.     if {[llength $biblist] && ![catch {Bib::_GotoEntry $entry $biblist 0}]} {
  489.     return
  490.     }
  491.     if ![catch {Bib::_GotoEntry $entry [Bib::ListAllBibliographies]}] {
  492.     return
  493.     }
  494.     beep
  495.     error "Can't find entry '$entry' in the .bib file(s)"
  496. }
  497.  
  498. ## 
  499.  # -------------------------------------------------------------------------
  500.  #     
  501.  # "Bib::gotoEntryFromIndex"    --
  502.  #    
  503.  #    Look in    the    bibIndex and find an entry very    quickly.
  504.  # -------------------------------------------------------------------------
  505.  ##
  506. proc Bib::gotoEntryFromIndex {entry} {
  507.     set bibTopPat {@([a-zA-Z]+)[\{\(][     ]*}
  508.     global PREFS
  509.     # if it fails, but we succeed later, we will have the opportunity
  510.     # to rebuild the bibIndex
  511.     if [file exists [file join ${PREFS} bibIndex]] {
  512.     source [file join ${PREFS} bibIndex]
  513.     foreach f [array names bibIndex] {
  514.         if [regexp "\[ \r\n\]$entry\[ \r\n\]" "$bibIndex($f)"] {
  515.         file::openQuietly $f
  516.         set p [search -s -f 1 -r 1 $bibTopPat$entry [minPos]]
  517.         eval select $p
  518.         refresh
  519.         eval select $p
  520.         unset bibIndex
  521.         return
  522.         }
  523.     }
  524.     unset bibIndex
  525.     }
  526.     error "Entry '$entry' not found in bibIndex"
  527. }
  528.  
  529. ## 
  530.  # -------------------------------------------------------------------------
  531.  #     
  532.  # "Bib::_FindAllEntries"    --
  533.  #    
  534.  #    Find all entries with a    given prefix, optionally attaching the titles
  535.  #    of the entries (this requires a    bibDatabase    file to    be setup).    Used
  536.  #    by TeX citation    completions: \cite{Darley<cmd-Tab>
  537.  # -------------------------------------------------------------------------
  538.  ##
  539. proc Bib::_FindAllEntries {eprefix {withtitles 1}} {
  540.     global PREFS 
  541.     set matches {}
  542.     if {$withtitles} {
  543.     if {![file exists [file join ${PREFS} bibDatabase]]} {
  544.         if {[askyesno "No bibDatabase exists, shall I make one?"]=="yes"} {
  545.         Bib::rebuildDatabase
  546.         } else {
  547.         error "No bib database exists"
  548.         }
  549.     }
  550.     set cid [scancontext create]
  551.     scanmatch $cid "^${eprefix}" {
  552.         lappend matches $matchInfo(line)
  553.     }
  554.     set fid [open [file join ${PREFS} bibDatabase] r]
  555.     scanfile $cid $fid
  556.     close $fid
  557.     scancontext delete $cid    
  558.     } else {
  559.     if ![file exists [file join ${PREFS} bibIndex]] {
  560.         if {[askyesno "No bibIndex exists, shall I make one?"]=="yes"} {
  561.         Bib::rebuildIndex
  562.         } else {
  563.         error "No bib index exists"
  564.         }
  565.     }
  566.     global bibIndex
  567.     if {![array exists bibIndex]} {
  568.         source [file join ${PREFS} bibIndex]
  569.         set unset 1
  570.     }
  571.     foreach f [array names bibIndex] {
  572.         eval lappend matches [completion::fromList $eprefix "bibIndex(${f})"]
  573.     }
  574.     if {[info exists unset]} {unset bibIndex}
  575.     }
  576.     return $matches    
  577. }
  578.  
  579. ## 
  580.  # -------------------------------------------------------------------------
  581.  #     
  582.  # "Bib::_GotoEntry" --
  583.  #    
  584.  #    Find a bib entry in    one    of the given list of files,    and    signal an
  585.  #    error if the entry isn't found.     I think this is the quickest way.
  586.  # -------------------------------------------------------------------------
  587.  ##
  588. proc Bib::_GotoEntry {entry biblist {rebuild 1}} {
  589.     set bibTopPat {@([a-zA-Z]+)[\{\(][     ]*}
  590.     set cid [scancontext create]
  591.     scanmatch $cid $bibTopPat$entry {
  592.     set found $matchInfo(offset)
  593.     }
  594.     set found ""
  595.     foreach f $biblist {
  596.     message "Searching [file tail $f]…"
  597.     if {![catch {set fid [open $f]}]} {
  598.         scanfile $cid $fid
  599.         close $fid
  600.         if {$found != ""} {
  601.         file::openQuietly $f
  602.         set found [pos::math [minPos] + $found]
  603.         goto $found
  604.         refresh
  605.         select $found [nextLineStart $found]
  606.         scancontext delete $cid
  607.         global BibmodeVars
  608.         # make the index since it was obviously out of date                
  609.         if {$rebuild == 1 && ($BibmodeVars(bibAutoIndex) == 2 \
  610.           || [dialog::yesno "The bibIndex seems to be out of date.  Rebuild?"])} {
  611.             Bib::rebuildIndex
  612.         }
  613.         return
  614.         }    
  615.     }
  616.     }
  617.     scancontext delete $cid
  618.     error "Entry '$entry' not found."
  619. }
  620.  
  621.  
  622. ## 
  623.  # -------------------------------------------------------------------------
  624.  #     
  625.  # "Bib::rebuildIndex" --
  626.  #    
  627.  #    Build the bibIndex file    which allows for very fast lookup of bib
  628.  #    entries.
  629.  # -------------------------------------------------------------------------
  630.  ##
  631. proc Bib::rebuildIndex {} {
  632.     global PREFS 
  633.     set bibTopPat2 {^[     ]*@([a-zA-Z]+)[\{\(][     ]*([^=,     ]+)}    
  634.     set cid [scancontext create]
  635.     # this will actually mark strings as well
  636.     scanmatch $cid $bibTopPat2 {
  637.     if {![regexp -nocase (preamble|string|comment) $matchInfo(submatch0)]} {
  638.         lappend found $matchInfo(submatch1)
  639.     }
  640.     }
  641.     set bout [open [file join ${PREFS} bibIndex] w]
  642.     puts $bout "# Bibliography index file for quick reference lookup"
  643.     puts $bout "# Created on [mtime [now]]"
  644.     set bibs [lsort [Bib::ListAllBibliographies]]
  645.     set bibl [llength $bibs]
  646.     foreach f $bibs {
  647.     set found {}
  648.     puts $bout "set \"bibIndex($f)\" \{"
  649.     message "Indexing ([incr bibl -1] left) [file tail $f]É"
  650.     if {![catch {set fid [open $f]}]} {
  651.         scanfile $cid $fid
  652.         close $fid
  653.     }
  654.     # we sort so we can search it efficiently for all entries with
  655.     # a given prefix.
  656.     puts $bout " [lsort $found] "
  657.     puts $bout "\}"
  658.     }
  659.     close $bout
  660.     scancontext delete $cid
  661.     message "bibIndex creation complete"
  662. }
  663.  
  664. ## 
  665.  # -------------------------------------------------------------------------
  666.  #     
  667.  # "Bib::rebuildDatabase" --
  668.  #    
  669.  #    Build the bibDatabase which    allows speedy completion of    citations and
  670.  #    contains titles, so    that you can pick the correct completion easily.
  671.  # -------------------------------------------------------------------------
  672.  ##
  673. proc Bib::rebuildDatabase {} {
  674.     global PREFS
  675.     set bdatout [open [file join ${PREFS} bibDatabase] w]
  676.     puts $bdatout "# Bibliography database file for quick reference lookup"
  677.     puts $bdatout "# Created on [mtime [now]]"
  678.     # if it fails, but we succeed later, we will have the opportunity
  679.     # to rebuild the bibIndex
  680.     set bibs [lsort -ignore [Bib::ListAllBibliographies]]
  681.     set bibl [llength $bibs]
  682.     foreach f $bibs {
  683.     file::openQuietly $f
  684.     message "Indexing ([incr bibl -1] left) [file tail $f]…"
  685.     puts $bdatout [Bib::makeDatabaseOf $f]
  686.     killWindow
  687.     }
  688.     close $bdatout
  689. }
  690.  
  691. proc Bib::indexOfThisWindow {{f ""}} {
  692.     if {$f == ""} {
  693.     set f [win::Current]
  694.     }
  695.     file::openQuietly $f
  696.     set ret [Bib::makeDatabaseOf $f]
  697.     new -n "* Index for [file tail $f] *" -m Text
  698.     insertText $ret
  699.     winReadOnly
  700. }
  701.  
  702. proc Bib::addWinToDatabase {{f ""}} {
  703.     if {$f == ""} {
  704.     set f [win::Current]
  705.     }
  706.     global PREFS
  707.     set bdatout [open [file join ${PREFS} bibDatabase] a]
  708.     file::openQuietly $f
  709.     puts $bdatout [Bib::makeDatabaseOf $f]
  710.     close $bdatout
  711. }
  712.  
  713. proc Bib::makeDatabaseOf {f} {
  714.     set bibTopPat {@([a-zA-Z]+)[\{\(][     ]*}
  715.     message "Indexing ${f}…"
  716.     set p [minPos]
  717.     set ret ""
  718.     while {![catch {search -s -f 1 -r 1 -- $bibTopPat $p} epos]} {
  719.     set p [lindex $epos 0]
  720.     set np [nextLineStart $p]
  721.     set entry [getText $p $np]
  722.     regexp {^@([a-zA-Z]+)([\{\(])[     ]*(.*)} $entry "" type brace entry
  723.     if {[regexp -nocase (preamble|string|comment) $type] \
  724.       || [catch {matchIt $brace [pos::math $p + [expr 3 + [string length $type]]]} end]} {
  725.         set p $np
  726.         continue
  727.     }
  728.     set p $end
  729.     if {![catch {search -s -f 1 -r 1 -l $end -- "title\[ \t\]*=\[ \t\]*" $np} epos]} {
  730.         set entry [string trim $entry "\{\( \t\r,"]
  731.         set epos [lindex $epos 1]
  732.         if {[regexp {[\(\{]} [lookAt $epos] brace] \
  733.           && ![catch {matchIt $brace [pos::math $epos + 1]} end] } {
  734.         set title [getText $epos $end]
  735.         } else {
  736.         set title [getText $epos [nextLineStart $epos]]
  737.         }
  738.         regsub -all "\[\{\}\]+" $title {} title
  739.         regsub -all "\[ \n\r\t\]+" $title { } title
  740.         append ret "$entry \{$title\}\r"
  741.     }
  742.     }   
  743.     return $ret
  744. }
  745.  
  746.  
  747. ###########################################################################
  748. # Menu command procs
  749. ###########################################################################
  750.         
  751. proc makeField {menu item} {
  752.     global fieldNames
  753.     bibFormatSetup
  754.     
  755.     if {$item == "multipleFields"} {
  756.     set flds [listpick -l -L {author year} -p "Pick desired fields:" $fieldNames]
  757.     if {[llength flds]} {
  758.         set lines {}
  759.         foreach fld $flds {
  760.         append lines [newField $fld]
  761.         }
  762.     } else {
  763.         return
  764.     }
  765.     } else {
  766.     set lines [newField $item]
  767.     }
  768.     
  769.     goto [nextLineStart [getPos]]
  770.     elec::Insertion $lines
  771. }
  772.  
  773. proc makeEntry {menu item} {
  774.     bibFormatSetup
  775.     newEntry $item
  776. }
  777.  
  778. ###########################################################################
  779. #  Return the bounds of the bibliographic entry surrounding the current 
  780. #  position.
  781. #
  782. proc getEntry {pos} {
  783.     
  784.     set pos1 [search -f 0 -r 1 -n -s {[     ]*@[a-zA-Z]*[\{\(]} $pos ]
  785.     if {$pos1 == ""} {
  786.         set begPos [nextLineStart $pos]
  787.         set endPos $begPos
  788.     } else {
  789.         set begPos [lineStart [lindex $pos1 0]]
  790.         set pos0 [lindex $pos1 1]
  791.         set openBrace [getText [pos::math $pos0 - 1] $pos0 ]
  792.         if {[catch {matchIt $openBrace $pos0} pos1]} {
  793.         alertnote "There seems to be a badly delimited field in here.  Are entry and field delimiters set correctly?"
  794.         goto $begPos
  795.         error "Can't find close brace"
  796.         } else {
  797.         set endPos [nextLineStart $pos1]
  798.         }
  799.     }
  800.     return [list $begPos $endPos]
  801. }
  802.  
  803. ###########################################################################
  804. #  Advance to the next bibliographic entry.
  805. #
  806. proc nextEntry {} {
  807.     global bibTopPat bibTopPat1 bibTopPat2
  808.     #     set topPat {[     ]*@([a-zA-Z]+)[\{\(]}
  809.     
  810.     set pos0 [lindex [getEntry [getPos]] 1]
  811.     set nextPos [nextLineStart $pos0]
  812.     
  813.     while {![catch {search -f 1 -r 1 -s $bibTopPat $pos0} pos]} {
  814.     regexp $bibTopPat [eval getText $pos] mtch type
  815.     if {$type != "string"} {
  816.         set nextPos [lindex $pos 0]
  817.         break
  818.     } else {
  819.         set pos0 [nextLineStart [lindex $pos 1]]
  820.     }
  821.     }
  822.     goto $nextPos
  823. }
  824.  
  825. ###########################################################################
  826. #  Go back to the previous bibliographic entry.
  827. #
  828. proc prevEntry {} {
  829.     global bibTopPat bibTopPat1 bibTopPat2
  830.     #     set topPat {[     ]*@([a-zA-Z]+)[\{\(]}
  831.     
  832.     set pos0 [lindex [getEntry [getPos]] 0]
  833.     if {[pos::compare $pos0 > [minPos]]} {
  834.     set nextPos $pos0
  835.     set pos0 [pos::math $pos0 - 1]
  836.     while {![catch {search -f 0 -r 1 -s $bibTopPat $pos0} pos]} {
  837.         regexp $bibTopPat [eval getText $pos] mtch type
  838.         if {$type != "string"} {
  839.         set nextPos [lindex $pos 0]
  840.         break
  841.         } else {
  842.         set pos0 [lineStart [lindex $pos 0]]
  843.         if {[pos::compare $pos0 == [minPos]]} {break}
  844.         set pos0 [pos::math $pos0 - 1]
  845.         }
  846.     }
  847.     goto $nextPos
  848.     }
  849. }
  850.  
  851. ###########################################################################
  852. #  Select (highlight) the current bibliographic entry.
  853. #
  854. proc selectEntry {} {
  855.     set pos [getEntry [getPos]]
  856.     select [lindex $pos 0] [lindex $pos 1]
  857. }
  858.  
  859. ###########################################################################
  860. #  Put the cite-key of the current entry on the clipboard.
  861. #
  862. proc copyCiteKey {} {
  863.     global bibTopPat2
  864.     set limits [getEntry [getPos]]
  865.     set top [lindex $limits 0]
  866.     set bottom [lindex $limits 1]
  867.     if {[regexp -indices $bibTopPat2 [getText $top $bottom] allofit type citekey]} {
  868.     select [pos::math $top + [lindex $citekey 0]] [pos::math $top + [expr [lindex $citekey 1] + 1]]
  869.     copy
  870.     message "Copied \"[getSelect]\""
  871.     } 
  872. }
  873.  
  874. ###########################################################################
  875. #  Create a new bibliographic entry with its required fields.
  876. #
  877. proc newEntry {entryName} {    
  878.     global  entryNames customEntries fieldNames rqdFld optFld myFld defFldVal
  879.     global bibOpenEntry bibCloseEntry BibmodeVars
  880.     goto [lindex [getEntry [getPos]] 1]
  881.     if {$entryName == "customEntry"} {
  882.     set lines "@••$bibOpenEntry••,\r"
  883.     set theFields [listpick -l -L {author} -p "Pick desired fields:" $fieldNames]
  884.     } else {
  885.     set lines "@${entryName}$bibOpenEntry••,\r"
  886.     if {[lsearch -exact $customEntries $entryName] >= 0 && [llength $myFld($entryName)]} {
  887.         set theFields $myFld($entryName)
  888.     } elseif {[lsearch -exact $entryNames $entryName] >= 0} {
  889.         set theFields $rqdFld($entryName)
  890.     } else {
  891.         set theFields {}
  892.     }
  893.     }
  894.     set nmlen 0
  895.     foreach field $theFields {
  896.     set len [string length $field]
  897.     if {$len > $nmlen} {set nmlen $len}        
  898.     }
  899.     set theTop [lineStart [getPos]]
  900.     foreach field $theFields {
  901.     catch {append lines [newField $field $nmlen]}
  902.     }
  903.     append lines "$bibCloseEntry\r"
  904.     elec::Insertion $lines
  905. }
  906.  
  907. ###########################################################################
  908. #  Create a new field within the current bibliographic entry
  909. #
  910. proc newField {fieldName {nmlen 0}} {    
  911.     global fieldNames useBrace bibOpenQuote bibCloseQuote bibIndent
  912.     global fieldDefs defFldVal
  913.     set spc "                   "
  914.     if {[lsearch -exact $fieldNames $fieldName] >= 0} {
  915.     set needBraces $useBrace($fieldName)
  916.     } else {
  917.     set needBraces 1
  918.     }
  919.     
  920.     if {[lsearch -exact $fieldDefs $fieldName] >= 0} {
  921.     set val $defFldVal($fieldName)
  922.     } else {
  923.     set val "••"
  924.     }
  925.     
  926.     if {$nmlen} {
  927.     set pad [string range $spc 1 [expr $nmlen - [string length $fieldName]]]
  928.     } else {
  929.     set pad ""
  930.     }            
  931.     if {$needBraces || $fieldName == "customField"} {
  932.     set result "$bibIndent$fieldName =$pad ${bibOpenQuote}${val}${bibCloseQuote},\r"
  933.     } else {
  934.     set result "$bibIndent$fieldName =$pad $val,\r"
  935.     }    
  936.     return $result
  937. }
  938.  
  939. proc bibFormatSetup {} {
  940.     global bibOpenQuote bibCloseQuote bibIndent BibmodeVars
  941.     global bibOpenEntry bibCloseEntry bibAbbrevs
  942.     bibFieldDelims
  943.     bibEntryDelims
  944.     set bibIndent $BibmodeVars(indentString)
  945.     regsub {\\t} $bibIndent {    } bibIndent
  946.     set bibAbbrevs [listStrings]
  947.     foreach abbrev $BibmodeVars(stdAbbrevs) {
  948.     lappend bibAbbrevs [string tolower $abbrev]
  949.     }
  950. }
  951.  
  952. ###########################################################################
  953. #  Find all entries that match a given regular expression and copy them to 
  954. #  a new buffer.
  955. #
  956. proc searchEntries {} {
  957.     if [catch {prompt "Regular expression:" ""} reg] return
  958.     if {![string length $reg]} return
  959.     set reg ^.*$reg.*$
  960.     
  961.     set matches [findEntries $reg]
  962.     if {[llength $matches] >0} {
  963.     writeEntries $matches 0
  964.     } else {
  965.     message "No matching entries were found"
  966.     }
  967. }
  968.  
  969. ###########################################################################
  970. #  Find all entries in which the indicated field matches a given regular 
  971. #  expression and copy them to a new buffer.  
  972. #
  973. proc searchFields {} {
  974.     global fieldNames
  975.     if {[catch {eval prompt {{Field name:}} "author" {Fields} $fieldNames} fld]} return
  976.     if {![string length $fld]} return
  977.     
  978.     if {[catch {prompt "Regular expression:" ""} reg]} return
  979.     if {![string length $reg]} return
  980.     
  981.     set matches [findEntries $reg]
  982.     if {[llength $matches] == 0} {
  983.     return "No matching entries were found"
  984.     }
  985.     
  986.     set vals {}
  987.     foreach hit $matches {
  988.     set pos [lindex $hit 1]
  989.     set top [lindex $hit 2] 
  990.     set bottom [lindex $hit 3]
  991.     while {[set failure [expr {[getFldName $pos $top] != $fld}]]  && 
  992.     ![catch {search -f 1 -r 1 -i 1 -m 0 -l $bottom -s -- $reg $pos} mtch]} {
  993.         set pos [lindex $mtch 1]
  994.     }
  995.     if {!$failure} { lappend vals [list $top $bottom] }
  996.     }
  997.     
  998.     if {[llength $vals] >0} {
  999.     writeEntries $vals 0
  1000.     } else {
  1001.     message "No matching entries were found"
  1002.     }
  1003.     
  1004. }
  1005.  
  1006. ###########################################################################
  1007. # Sort all of the entries based on one of various criteria.
  1008. #
  1009. proc bibSortProc {menu item} {
  1010.     if {$item == "citeKey"} {
  1011.     sortByCiteKey
  1012.     } elseif  {$item == "firstAuthor,Year"} {
  1013.     sortByAuthors 0 0
  1014.     } elseif  {$item == "lastAuthor,Year"} {
  1015.     sortByAuthors 1 0
  1016.     } elseif  {$item == "year,FirstAuthor"} {
  1017.     sortByAuthors 0 1
  1018.     } elseif  {$item == "year,LastAuthor"} {
  1019.     sortByAuthors 1 1
  1020.     }
  1021. }
  1022.  
  1023. ###########################################################################
  1024. # Sort the file marks. (These operations are also available under the
  1025. # "Search:NamedMarks" menu)
  1026. #
  1027. proc markSortProc {menu item} {
  1028.     if {$item == "alphabetically"} {
  1029.     sortMarksFile
  1030.     } elseif  {$item == "byPosition"} {
  1031.     orderMarks
  1032.     }
  1033. }
  1034.  
  1035. ###########################################################################
  1036. # Sort all of the entries in the file alphabetically by author.
  1037. #
  1038. proc sortByAuthors {{lastAuthorFirst 0} {yearFirst 0}} {
  1039.     global bibTopPat bibTopPat1 bibTopPat2 BibmodeVars
  1040.     set bibSegStr $BibmodeVars(segregateStrings)
  1041.     
  1042.     set matches [findEntries $bibTopPat]
  1043.     set crossrefs [listCrossrefs]
  1044.     set strings [listStrings]
  1045.     
  1046.     set vals {}
  1047.     set others {}
  1048.     set refs {}
  1049.     set strs {}
  1050.     
  1051.     set beg [maxPos]
  1052.     set end [minPos]
  1053.     
  1054.     foreach hit $matches {
  1055.     set pos [lindex $hit 1]
  1056.     set top [lindex $hit 2] 
  1057.     set bottom [lindex $hit 3]
  1058.     set entry [getText $top $bottom]
  1059.     regsub -all "\[\n\r\]+" $entry { } entry
  1060.     regsub -all "\[     \]\[     \]+" $entry { } entry
  1061.     regsub {[,     ]*[\)\}][     ]*$} $entry { } entry
  1062.     if {[regexp $bibTopPat1 $entry allofit citeKey]} {
  1063.         set citeKey [string tolower $citeKey]
  1064.         set keyExists 1
  1065.     } else {
  1066.         set citekey ""
  1067.         set keyExists 0
  1068.     }
  1069.     
  1070.     if {$keyExists && [lsearch -exact $crossrefs $citeKey] >= 0} {
  1071.         lappend refs [list $pos $top $bottom]
  1072.     } elseif {$bibSegStr && $keyExists && [lsearch -exact $strings $citeKey] >= 0} {
  1073.         lappend strs [list $citeKey $top $bottom]        
  1074.     } else {
  1075.         if {![catch {getFldValue $entry author} fldval]} {
  1076.         if {[catch {getFldValue $entry year} year]} { set year 9999 }
  1077.         lappend vals [list [authSortKey $fldval $lastAuthorFirst $year $yearFirst] $top $bottom]
  1078.         } else {
  1079.         lappend others [list $pos $top $bottom]
  1080.         }
  1081.     }
  1082.     if {[pos::compare $top < $beg]} {set beg $top}
  1083.     if {[pos::compare $bottom > $end]} {set end $bottom}
  1084.     }
  1085.     
  1086.     if {$bibSegStr} {
  1087.     set result [concat $strs $others [lsort $vals] $refs]
  1088.     } else {
  1089.     set result [concat $others [lsort $vals] $refs]
  1090.     }
  1091.     
  1092.     if {[llength $result] >0} {
  1093.     writeEntries $result 1 $beg $end
  1094.     } else {
  1095.     message "No results of author sort !!??"
  1096.     }
  1097. }
  1098.  
  1099. ###########################################################################
  1100. # Return a list of the cite-keys of all cross-referenced entries.
  1101. #
  1102. proc listStrings {} {
  1103.     global bibTopPat bibTopPat1 bibTopPat2
  1104.     set matches [findEntries {^[    ]*@string *[\{\(]} 0]
  1105.     
  1106.     message "scanning for @strings…"
  1107.     foreach hit $matches {
  1108.     set top [lindex $hit 2] 
  1109.     set bottom [lindex $hit 3]
  1110.     set entry [getText $top $bottom]
  1111.     regsub -all "\[\n\r\]+" $entry { } entry
  1112.     regsub -all "\[     \]\[     \]+" $entry { } entry
  1113.     regsub {[,     ]*[\)\}][     ]*$} $entry { } entry
  1114.     regexp $bibTopPat1 $entry allofit citekey
  1115.     set citekey [string tolower $citekey]
  1116.     if {[catch {incr strings($citekey)} num]} {
  1117.         set strings($citekey) 1
  1118.     }
  1119.     }
  1120.     if {[catch {lsort [array names strings]} res]} {
  1121.     set res {}
  1122.     }
  1123.     message ""
  1124.     return $res
  1125. }
  1126.  
  1127. ###########################################################################
  1128. # Return a list of the cite-keys of all cross-referenced entries.
  1129. #
  1130. proc listCrossrefs {} {
  1131.     set matches [findEntries {crossref}]
  1132.     catch {unset crossrefs}
  1133.     
  1134.     message "scanning for crossrefs…"
  1135.     foreach hit $matches {
  1136.     set top [lindex $hit 2] 
  1137.     set bottom [lindex $hit 3]
  1138.     set entry [getText $top $bottom]
  1139.     regsub -all "\[\n\r\]+" $entry { } entry
  1140.     regsub -all "\[     \]\[     \]+" $entry { } entry
  1141.     regsub {[,     ]*[\)\}][     ]*$} $entry { } entry
  1142.     if {![catch {getFldValue $entry crossref} fldval]} {
  1143.         set fldval [string tolower $fldval]
  1144.         if {[catch {incr crossref($fldval)} num]} {
  1145.         set crossrefs($fldval) 1
  1146.         }
  1147.     }
  1148.     }
  1149.     if {[catch {lsort [array names crossrefs]} res]} {
  1150.     set res {}
  1151.     }
  1152.     message ""
  1153.     return $res
  1154. }
  1155.  
  1156. ###########################################################################
  1157. # Create a sort key from an author list.  When sorting entries by author, 
  1158. # performing the sort using keys should be faster than reparsing the author 
  1159. # lists for every comparison (the old method :-( ).
  1160. #
  1161. proc authSortKey {authList lastAuthorFirst {year {}} {yearFirst 0}} {
  1162.     global BibmodeVars
  1163.     set pat1 {\\.\{([A-Za-z])\}}
  1164.     set pat2 {\{([^\{\}]+) ([^\{\}]+)\}}
  1165.     
  1166.     # Remove enclosing braces, quotes, or whitespace
  1167.     set auths %[string trim $authList {{}"     }]&
  1168.     # Remove TeX codes for accented characters
  1169.     regsub -all $pat1 $auths {\1} auths
  1170.     # Concatenate strings enclosed in braces
  1171.     while {[regsub -all $pat2 $auths {{\1\2}} auths]} {}
  1172.     # Remove braces (curly and square)
  1173.     regsub -all {[][\{\}]} $auths {} auths
  1174.     #    regsub -all {,} $auths { ,} auths
  1175.     # Replace 'and's with begin-name/end-name delimiters
  1176.     regsub -all {[     ]and[     ]} $auths { \&% } auths
  1177.     # Put last name first in name fields without commas
  1178.     regsub -all {%([^\&,]+) ([^\&, ]+) *\&} $auths {%\2,\1\&} auths
  1179.     # Remove begin-name delimiters
  1180.     regsub -all {%} $auths {} auths
  1181.     # Remove whitespace surrounding name separators
  1182.     regsub -all {[     ]*\&[     ]*} $auths {\&} auths
  1183.     # Replace whitespace separating words with shrieks 
  1184.     regsub -all {[     ,]+} $auths {!} auths
  1185.     # If desired, move last author to head of sort key
  1186.     if {$lastAuthorFirst} {
  1187.     regsub {(.*)&([^&]+)&?$} $auths {\2\&\1} auths
  1188.     }
  1189.     # If provided, sort by year (descending order) as well
  1190.     regsub {^[^0-9]*([0-9]*).*$} $year {\1} year
  1191.     if {$year != {}} {
  1192.     if {$BibmodeVars(descendingYears)} { catch {set year [expr 9999-$year]} }
  1193.     if {$yearFirst} {
  1194.         set auths "$year&$auths"
  1195.     } else {        
  1196.         regsub {^([^&]+)(&?)} $auths "\\1\\&${year}\\2" auths
  1197.     }
  1198.     }
  1199.     
  1200.     return $auths
  1201. }
  1202.  
  1203. ###########################################################################
  1204. # Sort all of the entries in the file alphabetically by their cite-keys.
  1205. #
  1206. proc sortByCiteKey {} {
  1207.     global bibTopPat bibTopPat1 bibTopPat2 BibmodeVars
  1208.     set bibSegStr $BibmodeVars(segregateStrings)
  1209.     
  1210.     set matches [findEntries $bibTopPat]
  1211.     set crossrefs [listCrossrefs]
  1212.     set strings [listStrings]
  1213.     
  1214.     set begEntries [maxPos]
  1215.     set endEntries [minPos]
  1216.     
  1217.     set strs {}
  1218.     set vals {}
  1219.     set refs {}
  1220.     
  1221.     foreach hit $matches {
  1222.     set beg [lindex $hit 0]
  1223.     set end [lindex $hit 1]
  1224.     set top [lindex $hit 2] 
  1225.     set bottom [lindex $hit 3]
  1226.     if {[regexp $bibTopPat1 [getText $top $bottom] allofit citekey]} {
  1227.         set citekey [string tolower $citekey]
  1228.         set keyExists 1
  1229.     } else {
  1230.         set citekey "000000$beg"
  1231.         set keyExists 0
  1232.     }
  1233.     
  1234.     if {$keyExists && [lsearch -exact $crossrefs $citekey] >= 0} {
  1235.         lappend refs [list $top $top $bottom]
  1236.     } elseif {$keyExists && $bibSegStr && [lsearch -exact $strings $citekey] >= 0} {
  1237.         lappend strs [list $citekey $top $bottom]        
  1238.     } else {
  1239.         lappend vals [list $citekey $top $bottom]
  1240.     }
  1241.     
  1242.     if {[pos::compare $top < $begEntries]} {set begEntries $top}
  1243.     if {[pos::compare $bottom > $endEntries]} {set endEntries $bottom}
  1244.     }
  1245.     
  1246.     if {$bibSegStr} {
  1247.     set result [concat $strs [lsort $vals] $refs]
  1248.     } else {
  1249.     set result [concat [lsort $vals] $refs]
  1250.     }
  1251.     
  1252.     if {[llength $result] >0} {
  1253.     writeEntries $result 1 $begEntries $endEntries
  1254.     } else {
  1255.     message "No results of cite-key sort !!??"
  1256.     }
  1257. }
  1258.  
  1259. ###########################################################################
  1260. # Search for all entries matching a given regular expression.  The results
  1261. # are returned in a list, each element of which is a list of four integers:
  1262. # the beginning and end of the matching entry and the beginning and end of
  1263. # the matching string.  Adapted from "matchingLines" in "misc.tcl".
  1264. #
  1265. proc findEntries {reg {casesen 1}} {
  1266.     if {![string length $reg]} return
  1267.     
  1268.     set pos [minPos]   
  1269.     set result {}                             
  1270.     while {![catch {search -f 1 -r 1 -m 0 -i $casesen -s $reg $pos} mtch]} {
  1271.     set entry [getEntry [lindex $mtch 0]]
  1272.     lappend result [concat $mtch $entry]
  1273.     set pos [lindex $entry 1]
  1274.     }
  1275.     return $result
  1276. }
  1277.  
  1278. ###########################################################################
  1279. #  Return a list containing the data for the current entry, indexed by
  1280. #  the parameter names, e.g., "author", "year", etc.  Index names for the 
  1281. #  entry type and cite-key are "type" and "citekey". 
  1282. #
  1283. proc getFields {pos} {
  1284.     global bibTopPat bibTopPat1 bibTopPat2 bibTopPat3
  1285.     set fldPat {[     ]*([a-zA-Z]+)[     ]*=[     ]*}
  1286.     
  1287.     set limits [getEntry $pos]
  1288.     set top [lindex $limits 0]
  1289.     set bottom [lindex $limits 1]
  1290.     
  1291.     set entry [getText $top $bottom]
  1292.     regsub -all "\[\n\r\]+" $entry { } entry
  1293.     regsub -all "\[     \]\[     \]+" $entry { } entry
  1294.     #
  1295.     regsub {[,     ]*[\)\}][     ]*$} $entry { } entry
  1296.     
  1297.     if {[regexp -indices $bibTopPat2 $entry mtch theType theKey ]} {
  1298.     set key [string range $entry [lindex $theKey 0] [lindex $theKey 1]]
  1299.     set theRest [expr 1 + [lindex $mtch 1]]
  1300.     } elseif {[regexp -indices $bibTopPat3 $entry mtch theType aField]} {
  1301.     set key {}
  1302.     set theRest [lindex $aField 0]
  1303.     } else {
  1304.     error "Invalid entry"
  1305.     }
  1306.     lappend names type
  1307.     set type [string tolower [string range $entry [lindex $theType 0] [lindex $theType 1]]]
  1308.     lappend data [list $type]
  1309.     
  1310.     lappend names citekey
  1311.     lappend data $key
  1312.     
  1313.     set entry ",[string range $entry $theRest end]"
  1314.     set fldPat {,[     ]*([^ =,]+)[     ]*=[     ]*}
  1315.     set name {}
  1316.     while {[regexp -indices $fldPat $entry mtch sub1]} {
  1317.     set nextName [string range $entry [lindex $sub1 0] [lindex $sub1 1]]
  1318.     lappend names [string tolower $nextName]
  1319.     if {$name != ""} { 
  1320.         set prevData [string range $entry 0 [expr [lindex $mtch 0]-1]]
  1321.         lappend data [breakIntoLines [bibFieldData $prevData]]
  1322.     }    
  1323.     set name $nextName
  1324.     set entry [string range $entry [expr [lindex $mtch 1]+1] end]
  1325.     }
  1326.     
  1327.     lappend data [breakIntoLines [bibFieldData $entry]]
  1328.     
  1329.     return [list $names $data]
  1330. }
  1331.  
  1332. proc bibFieldData {text} {
  1333.     set text [string trim $text {     ,#}]
  1334.     set text1 [string trim $text {\{\}\"     }]            
  1335.     
  1336.     if {[string match {*[\{\}\"]*} $text1]} {
  1337.     set words [parseWords $text]
  1338.     if {[llength $words]==1} {
  1339.         regsub {^[\{\"\']} $text {} text
  1340.         regsub {[\}\"\']$} $text {} text
  1341.     }
  1342.     } else {
  1343.     set text $text1            
  1344.     }
  1345.     return $text
  1346. }
  1347.  
  1348.  
  1349. ###########################################################################
  1350. # Extract the data from the indicated field of an entry, which is passed 
  1351. # as a single string.  This version tries to be completely general, 
  1352. # allowing nested braces within data fields and ignoring escaped 
  1353. # delimiters.  (derived from proc getField).
  1354. #
  1355. proc getFldValue {entry fldname} {
  1356.     set fldPat "\[     \]*${fldname}\[     \]*=\[     \]*"
  1357.     set fldPat2 {,[     ]*([^ =,]+)[     ]*=[     ]*}
  1358.     set slash "\\"
  1359.     set qslash "\\\\"
  1360.     
  1361.     set ok [regexp -indices -nocase $fldPat $entry mtch]
  1362.     if {$ok} {
  1363.     set pos [expr [lindex $mtch 1] + 1]
  1364.     set entry [string range $entry $pos end]
  1365.     
  1366.     if {[regexp -indices $fldPat2 $entry mtch sub1]} {
  1367.         set entry [string range $entry 0 [expr [lindex $mtch 0]-1]]
  1368.     } 
  1369.     set fld [bibFieldData $entry]
  1370.     
  1371.     return $fld
  1372.     
  1373.     } else {
  1374.     error "field not found"
  1375.     }
  1376. }
  1377.  
  1378. ###########################################################################
  1379. # Parse the entry around position "pos" and rewrite it to the original 
  1380. # buffer in a canonical format
  1381. #
  1382. proc formatEntry {} {
  1383.     global useBrace bibOpenQuote bibCloseQuote 
  1384.     global bibOpenEntry bibCloseEntry bibIndent
  1385.     set spc "                           "
  1386.     
  1387.     bibFormatSetup
  1388.     
  1389.     set pos [getPos]
  1390.     set limits [getEntry $pos]
  1391.     set top [lindex $limits 0]
  1392.     set bottom [lindex $limits 1]
  1393.     
  1394.     if {![catch {bibFormatEntry $pos} result]} {
  1395.     if {$result != [getText $top $bottom]} {
  1396.         replaceText $top $bottom $result
  1397.     } 
  1398.     goto $top 
  1399.     nextEntry
  1400.     } else {
  1401.     message "Couldn't format this entry for some reason"
  1402.     }
  1403. }
  1404.  
  1405. ###########################################################################
  1406. # Parse the entry around position "pos" and rewrite it to the original 
  1407. # buffer in a canonical format
  1408. #
  1409. proc formatAllEntries {} {
  1410.     global useBrace bibOpenQuote bibCloseQuote 
  1411.     global bibOpenEntry bibCloseEntry bibIndent
  1412.     set spc "                           "
  1413.     
  1414.     bibFormatSetup
  1415.     
  1416.     # This little dance handles the case that the first 
  1417.     # entry starts on the first line
  1418.     #
  1419.     set hit [getEntry [getPos]]
  1420.     if {[pos::compare [lindex $hit 0] == [lindex $hit 1]]} {
  1421.     nextEntry
  1422.     set hit [getEntry [getPos]]
  1423.     }
  1424.     
  1425.     while {[pos::compare [getPos] < [lindex $hit 1]]} {
  1426.     set top [lindex $hit 0] 
  1427.     set bottom [lindex $hit 1]
  1428.     
  1429.     if {![catch {bibFormatEntry $top} result]} {
  1430.         set oldEntry [getText $top $bottom]
  1431.         if {$result != $oldEntry} {
  1432.         deleteText $top $bottom 
  1433.         insertText $result
  1434.         } 
  1435.     }
  1436.     goto $top
  1437.     nextEntry
  1438.     set hit [getEntry [getPos]]
  1439.     }
  1440. }
  1441.  
  1442. ###########################################################################
  1443. # Parse the entry around position "pos" and rewrite it in a canonical format.
  1444. # The formatted entry is returned.
  1445. #
  1446. proc bibFormatEntry {pos} {
  1447.     global useBrace bibOpenQuote bibCloseQuote 
  1448.     global bibOpenEntry bibCloseEntry bibIndent
  1449.     global rqdFld optFld BibmodeVars bibAbbrevs
  1450.     set spc "                           "
  1451.     #    
  1452.     #    note: calling proc must call "bibFormatSetup" before calling "bibFormatEntry"
  1453.     #
  1454.     set limits [getEntry $pos]
  1455.     set top [lindex $limits 0]
  1456.     set bottom [lindex $limits 1]
  1457.     
  1458.     if {[catch {getFields $pos} flds]} {
  1459.     error "bibFormatEntry: Getflds couldn't find any"
  1460.     }
  1461.     
  1462.     set names [lindex $flds 0]
  1463.     set vals [lindex $flds 1]
  1464.     set nfld [llength $names]
  1465.     
  1466.     set type [string tolower [lindex $vals 0]]
  1467.     set citekey [lindex $vals 1]
  1468.     #     message "$citekey"
  1469.     # Don't process @string entries
  1470.     if {$type == "string"} {
  1471.     set lines [getText $top $bottom]
  1472.     return $lines
  1473.     }
  1474.     # Find length of longest field name
  1475.     set nmlen 0
  1476.     foreach nm $names {
  1477.     set len [string length $nm]
  1478.     if {$len > $nmlen} { set nmlen $len }
  1479.     if {![info exists useBrace($nm)]} { set useBrace($nm) 0 }
  1480.     }
  1481.     
  1482.     # Format first line
  1483.     set lines "@${type}${bibOpenEntry}${citekey},\r"
  1484.     
  1485.     # Format each field on a separate line
  1486.     for {set ifld 2} {$ifld < $nfld} {incr ifld} { 
  1487.     set nm [lindex $names $ifld]
  1488.     set vl [lindex $vals $ifld]
  1489.     if {$vl != "" || ! $BibmodeVars(zapEmptyFields) || 
  1490.     [lsearch $rqdFld($type) $nm] >= 0} {
  1491.         set pad [expr $nmlen - [string length $nm]]
  1492.         
  1493.         if {$BibmodeVars(alignEquals)} {
  1494.         set pref "${bibIndent}$nm[string range $spc 1 $pad] ="
  1495.         } else {
  1496.         set pref "${bibIndent}$nm =[string range $spc 1 $pad]"
  1497.         }
  1498.         set ind [string range $spc 1 [string length $pref]]
  1499.         
  1500.         # Delimit field, if appropriate
  1501.         set noBrace [expr ($useBrace($nm) == 0 && [is::UnsignedInteger $vl]) || [regexp {\#} $vl]]
  1502.         if {$noBrace == 0 && [string first " " $vl] < 0} {
  1503.         set noBrace [expr [lsearch $bibAbbrevs [string tolower $vl]] >= 0]
  1504.         }
  1505.         if {$noBrace != 0} {
  1506.         set vl "$vl,"
  1507.         } else {
  1508.         set vl "${bibOpenQuote}${vl}${bibCloseQuote},"
  1509.         }
  1510.         
  1511.         set pieces [split $vl "\r"]
  1512.         append lines "$pref [lindex $pieces 0]\r"
  1513.         foreach piece [lrange $pieces 1 end] {
  1514.         append lines "$ind  $piece\r"
  1515.         }
  1516.     }
  1517.     }
  1518.     append lines "$bibCloseEntry\r"
  1519.     return $lines
  1520. }
  1521.  
  1522. ###########################################################################
  1523. # Get the name of the field that starts before the given position,  
  1524. # $pos.  The positions $top and $bottom restrict the range of the 
  1525. # search for the beginning and end of the field; typically, $top and
  1526. # $bottom will be the limits of a given entry.
  1527. #
  1528. proc getFldName {pos top} {
  1529.     set fldPat {[,     ]+([^     =,\{\}\"\']+)[     ]*=[     ]*}
  1530.     if {![catch {search -f 0 -r 1 -m 0 -i 1 -s -limit $top "$fldPat" $pos} mtch]} {
  1531.     set theText [eval getText $mtch]
  1532.     regexp -nocase $fldPat $theText allofit fldnam
  1533.     return $fldnam
  1534.     } else {
  1535.     return {citekey}
  1536.     }
  1537. }
  1538.  
  1539. ###########################################################################
  1540. #  Set the quote characters for quoted fields based on the value of the 
  1541. #  flag $bibUseBrace
  1542. proc bibFieldDelims {} {
  1543.     global BibmodeVars bibOpenQuote bibCloseQuote
  1544.     if {$BibmodeVars(fieldBraces)} {
  1545.         set bibOpenQuote "{"
  1546.         set bibCloseQuote "}" 
  1547.     } else {
  1548.         set bibOpenQuote {"} 
  1549.         set bibCloseQuote {"} 
  1550.     }
  1551. }
  1552.  
  1553. proc bibEntryDelims {} {
  1554.     global BibmodeVars bibOpenEntry bibCloseEntry
  1555.     if {$BibmodeVars(entryBraces)} {
  1556.         set bibOpenEntry "{"
  1557.         set bibCloseEntry "}" 
  1558.     } else {
  1559.         set bibOpenEntry "("
  1560.         set bibCloseEntry ")"
  1561.     }
  1562. }
  1563.  
  1564. proc isBibFile {} {
  1565.     set fileName [win::Current]   
  1566.     set ext [file extension $fileName]
  1567.     return [string match ".bib" [string tolower $ext]] 
  1568. }
  1569.  
  1570.  
  1571.  
  1572. ###########################################################################
  1573. # Take a list of lists that point to selected entries and copy these into
  1574. # a new window.  The beginning and ending positions for each entry must 
  1575. # be the last two items in each sublist.  The rest of the sublists are
  1576. # ignored.  It is assumed that each sublist has the same number of items.
  1577. #
  1578. proc writeEntries {entryPos nondestructive {beg {0}} {end {-1}}} {
  1579.     global BibmodeVars
  1580.     if {$end < 0} {set end [maxPos]}
  1581.     set llen [expr [llength [lindex $entryPos 0]] - 1]
  1582.     set llen1 [expr {$llen-1}]
  1583.     foreach entry $entryPos {
  1584.     set limits [lrange $entry $llen1 $llen]
  1585.     append lines [eval getText $limits]
  1586.     }
  1587.     set overwriteOK [expr $nondestructive || ! [isBibFile]]
  1588.     if {$BibmodeVars(overwriteBuffer) && $overwriteOK} {
  1589.     deleteText $beg $end
  1590.     insertText $lines
  1591.     goto $beg
  1592.     } else {
  1593.     set begLines [getText [minPos] [lineStart $beg]]
  1594.     set endLines [getText [nextLineStart $end] [maxPos]]
  1595.     new -n {*BibTeX Sort/Search*} -m Bib
  1596.     insertText $begLines
  1597.     insertText $lines
  1598.     insertText $endLines
  1599.     goto $beg
  1600.     setWinInfo dirty 0
  1601.     catch shrinkWindow
  1602.     }
  1603. }
  1604.  
  1605. ###########################################################################
  1606. # Set a named mark for each entry, using the cite-key name
  1607. #
  1608. proc Bib::MarkFile {} {
  1609.     global BibmodeVars
  1610.     global bibTopPat bibTopPat1 bibTopPat2
  1611.     set pos [minPos]
  1612.     while {![catch {search -f 1 -r 1 -m 0 -i 0 -s $bibTopPat1 $pos} res]} {
  1613.     set start [lindex $res 0]
  1614.     set pos [nextLineStart $start]
  1615.     set text [getText $start $pos]
  1616.     if {[regexp $bibTopPat2 $text mtch type citekey]} {
  1617.         if {[string tolower $type] != "string" || $BibmodeVars(markStrings)} { 
  1618.         setNamedMark $citekey [lineStart [pos::math $start - 1]] $start $start
  1619.         }
  1620.     }
  1621.     }
  1622. }
  1623.  
  1624. ###########################################################################
  1625. # Report the number of entries of each type
  1626. #
  1627. proc countEntries {} {
  1628.     global entryNames
  1629.     global bibTopPat bibTopPat1 bibTopPat2
  1630.     
  1631.     set pos [minPos]
  1632.     set count 0
  1633.     catch {unset type}
  1634.     
  1635.     while {![catch {search -f 1 -r 1 -m 0 -i 0 -s $bibTopPat $pos} res]} {
  1636.     incr count
  1637.     set start [lindex $res 0]
  1638.     set end [nextLineStart $start]
  1639.     set text [getText $start $end]
  1640.     set lab ""
  1641.     if {[regexp $bibTopPat $text mtch entryType]} {
  1642.         set entryType [string tolower $entryType]
  1643.         if {[catch {incr type($entryType)} num]} {
  1644.         set type($entryType) 1
  1645.         }
  1646.     }
  1647.     set pos $end
  1648.     }
  1649.     new -n {*BibTeX Statistics*} -m Bib
  1650.     foreach name [lsort [array names type]] {
  1651.     if {$type($name) > 0} {
  1652.         append lines [format "%4.0d  %s\n" $type($name) $name]
  1653.     }
  1654.     }
  1655.     append lines "----  -----------------\n"
  1656.     append lines [format "%4.0d  %s\n" $count "Total entries"]
  1657.     insertText $lines
  1658.     goto [minPos]
  1659.     setWinInfo dirty 0
  1660.     catch {shrinkWindow 1}
  1661. }
  1662. #--------------------------------------------------------------------------
  1663. # command-double-clicking:
  1664. #--------------------------------------------------------------------------
  1665.  
  1666. ###########################################################################
  1667. # In Bib mode, Cmd-double-clicks resolve abbrevs and cross-refs
  1668. #
  1669. proc Bib::DblClick {from to} {
  1670.     global bibTopPat bibTopPat1 bibTopPat2
  1671.     
  1672.     set limits [getEntry $from]
  1673.     set top [lindex $limits 0]
  1674.     set bottom [lindex $limits 1]
  1675.     
  1676.     # Extend selection to largest string that could be an entry reference
  1677.     set text [string trim [eval getText [BibExtendClick $from $to $top $bottom]]]
  1678.     
  1679.     # Get the citekey of current entry, so we can avoid jumping to it    
  1680.     set citekey {}
  1681.     regexp $bibTopPat2 [getText $top $bottom] mtch type citekey ]
  1682.     set fldName [getFldName $from $top]
  1683.     
  1684.     if {[string length $text] == 0 || $text == $citekey || $fldName == $text || 
  1685.     ($fldName == "citekey" && [string tolower $type] != "string")} {
  1686.     message "Command-double-click on abbreviations and crossref arguments"
  1687.     return
  1688.     }
  1689.     
  1690.     # Jump to the mark for the specified citation, if a mark exists...
  1691.     # ...otherwise, do an ordinary search for the cite key
  1692.     pushPosition    
  1693.     set searchPat "$bibTopPat\[     \]*[quote::Regfind $text]\[     ,\}\)\]"
  1694.     if {![catch {search -f 1 -r 1 -i 1 -m 0 $searchPat 0} mtch]} {
  1695.     goto [lindex $mtch 0]
  1696.     } else {
  1697.     popPosition
  1698.     select $from $to
  1699.     if {$fldName == "crossref"} {
  1700.         message "Cross-reference \"$text\" not found"
  1701.     } else {
  1702.         message "Command-double-click on abbreviations and crossref arguments"
  1703.     }
  1704.     return
  1705.     }
  1706.     message "Use Ctl-. to return to original position"
  1707.     return
  1708. }
  1709.  
  1710. # Extend the selection around the initial selection {$from,$to}
  1711. # Extension is restricted to the range {$top,$bottom} (the current entry)
  1712. proc BibExtendClick {from to top bottom} {
  1713.     if {$to == [minPos]} { set to $from }
  1714.     set result [list $from $to]
  1715.     if {![catch {search -f 0 -r 1 -s -m 0 -l $top "\[,\{\]\"\'=" $from} mtch0]} {
  1716.         if {![catch {search -f 1 -r 1 -s -m 0 -l $bottom "\[,\}\]\"\'=" $to} mtch1]} {
  1717.             set from [lindex $mtch0 1]
  1718.             set to [lindex $mtch1 0]
  1719.             # Check for illegal chars embedded in the selection
  1720.             if {[regexp "\[\{\}\]=" [getText $from $to]] == 0} {
  1721.                 set result [list $from $to]
  1722.             }
  1723.         }
  1724.     }
  1725.     return $result
  1726. }
  1727.  
  1728. #===============================================================================
  1729. proc pcite {} {
  1730.     set words [getline "Citation keys" ""]
  1731.     if {![llength $words]} {error "No keys"}
  1732.     
  1733.     set pattern {@}
  1734.     foreach w $words {
  1735.     append pattern "(\[^@\]+$w)"
  1736.     }
  1737.     
  1738.     foreach entry [findEntries $pattern] {
  1739.     set res [getFields [car $entry]]
  1740.     set title [lindex [cadr $res] [lsearch [car $res] "title"]]
  1741.     set citekey [lindex [cadr $res] [lsearch [car $res] "citekey"]]
  1742.     set matches($title) $citekey
  1743.     set where($title) [car $entry]
  1744.     }
  1745.     if {![info exists matches]} {alertnote "No citations"; return}
  1746.     set title [listpick -p "Citation?" [lsort [array names matches]]]
  1747.     putScrap $matches($title)
  1748.     alertnote $matches($title)
  1749.     goto $where($title)
  1750. }
  1751.  
  1752.  
  1753.